#
# HTML::Shark/Group.pm
#
# Copyright (C) 2004 Albacore Technology, LLC All Rights Reserved
#
#

#
# NOTE:
#       - Script paths must be unique
#       - Script group names must be unique
#       - Module names must be unique
#

package HTML::Shark::Group;

use strict;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
use Exporter;

#
# public (exported) variables
#
$VERSION   = 0.01;
@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw();

#
# private (non-exported) variables
#
my $_SCRIPT_GROUPS;
my $_SCRIPT;
my $_SCRIPTS;
my $_MODULES;

#
# Encapsulated class data
#
my %_attr_data = (
  'attrs' => {
    'paths'   => [],
    'params'  => [],
    'name'    => 'group',
    'title'   => '',
    'icon'    => '',
    'desc'    => '',
    'menu'    => '',
    'module'  => '',
    'base'    => '',
    'tab'     => 'y',
    'pri'     => 0,
    'roles'   => [],
    'handler' => '',
  },
  # 0 -> arg, 1 -> arg hash
  'process_attrs' => sub {
      my ($args) = @_;

      foreach (qw( paths params roles )) {
        $args->{$_} = [ $args->{$_} ] unless ( ref $args->{$_} eq 'ARRAY' );
      }

      unless( $args->{'title'} ) {
        $args->{'title'} = $args->{'paths'}->[0];
        $args->{'title'} =~ s|_| |g;
        $args->{'title'} = Data::Shark::Util::mc( $args->{'title'} );
      }

      unless( $args->{'icon'} ) {
        $args->{'icon'} =~ m|([^/]+)$|;
        $args->{'icon'} = $1;
      }

      unless( $args->{'menu'} ) {
        $args->{'menu'} = $args->{'title'};
      }
  },
);

#
# Class methods, to operate on encapsulated class data
#

# Classwide default value for a specified object attribute
sub _set_attr {
  my ($args, $attr) = @_;
  # set default
  $args->{$attr} = $_attr_data{'attrs'}{$attr} unless exists $args->{$attr};
}

# Classwide attribute processing
sub _process_attr {
  my ($args) = @_;
  $_attr_data{'process_attrs'}->($args) if exists $_attr_data{'process_attrs'};
}

# List of names of all specified object attributes
sub _standard_keys {
  keys %{$_attr_data{'attrs'}};
}

#
# public class methods
#
sub get_module {
  my ($module) = @_;
  return (exists $_MODULES->{$module}?$_MODULES->{$module}:undef);
}

sub register_module {
  my ($obj) = @_;

  _set_attr($obj,$_) foreach ( _standard_keys() );

  _process_attr($obj);

  my $module = {'name'          => $obj->{'name'},
                'title'         => $obj->{'title'},
                'icon'          => $obj->{'icon'},
                'desc'          => $obj->{'desc'},
                'module'        => $obj->{'module'},
                'menu'          => $obj->{'menu'},
                'pri'           => $obj->{'pri'},
                'base'          => $obj->{'base'},
                'tab'           => $obj->{'tab'} || 'y',
                'roles'         => $obj->{'roles'},
                'client_roles'  => $obj->{'client_roles'},
  };

  $_MODULES->{ $module->{'name'} } = $module;

  return $module;
}

sub register_modules {
  my ($modules) = @_;

  return unless (ref $modules eq 'ARRAY');

  register_module($_) foreach (@{$modules});
}

sub user_script_modules {
  my ($userinfo) = @_;

  #return [] unless $userinfo;

  # get script modules for user roles
  my @names = ();
  for my $script_module (values %{$_MODULES}) {

    # first check for client role they are top level
    if (scalar @{$script_module->{ client_roles }}) {

      # found a client role make sure we have it
      my $client_ok = 0;
      for (@{$script_module->{ client_roles }}) {
        exists $userinfo->{'client_roles'}{$_} && do {
          $client_ok = 1;
          last;
        };
      }

      next unless $client_ok;
    }

    if( !@{$script_module->{ roles }} ) {
      push @names, $script_module->{ name };
      next;
    }

    for (@{$script_module->{ roles }}) {
      exists $userinfo->{'roles'}{$_} && do {
        push @names, $script_module->{ name };
        last;
      };
    }
  }

  # sort script modules by priority
  my @sorted_names = sort {$_MODULES->{$a}->{pri} <=> $_MODULES->{$b}->{pri}} @names;

  my @user_script_modules = ();
  for my $name (@sorted_names) {
    my %script_module = %{$_MODULES->{ $name }};
    push @user_script_modules, \%script_module;
  }

  return \@user_script_modules;
}

sub get_script {
  my ($path) = @_;
  return (exists $_SCRIPTS->{$path}?$_SCRIPTS->{$path}:undef);
}

sub register_script_group {
  my ($obj) = @_;

  _set_attr($obj,$_) foreach ( _standard_keys() );

  _process_attr($obj);

  my $group = {'name'          => $obj->{'name'},
               'title'         => $obj->{'title'},
               'module'        => $obj->{'module'},
               'icon'          => $obj->{'icon'},
               'desc'          => $obj->{'desc'},
               'pri'           => $obj->{'pri'},
               'paths'         => $obj->{'paths'},
               'roles'         => $obj->{'roles'},
               'client_roles'  => $obj->{'client_roles'},
  };

  $_SCRIPT_GROUPS->{ $group->{'name'} } = $group;

  return $group;
}

sub register_script_groups {
  my ($groups) = @_;

  return unless (ref $groups eq 'ARRAY');

  register_script_group($_) foreach (@{$groups});
}

sub register_script
{
  my ($obj) = @_;

  _set_attr($obj,$_) foreach ( _standard_keys() );

  _process_attr($obj);

  my $script = {'paths'           => $obj->{'paths'},
                'params'          => $obj->{'params'},
                'handler'         => $obj->{'handler'},
                'title'           => $obj->{'title'},
                'icon'            => $obj->{'icon'},
                'desc'            => $obj->{'desc'},
                'roles'           => $obj->{'roles'},
                'client_roles'    => $obj->{'client_roles'},
  };

  $_SCRIPTS->{ $_ } = $script
    for (@{$script->{'paths'}});

  return $script;
}

sub register_scripts {
  my ($scripts) = @_;

  return unless (ref $scripts eq 'ARRAY');

  register_script($_) foreach (@{$scripts});
}

sub user_script_groups {
  my ($userinfo, $module) = @_;

  $module = '' unless defined $module;

  # get script groups for user roles
  my @names = ();
  for my $script_group (values %{$_SCRIPT_GROUPS}) {

    next unless $script_group->{'module'} eq $module;

    my $module_obj    = get_module( $module );

    # if we have a module and it has roles check perms, etc
    if ($module_obj && $module_obj->{ roles } && scalar @{$module_obj->{ roles }}) {

      my $have_role = 0;

      for (@{$module_obj->{ roles }}) {
        exists $userinfo->{'roles'}{$_} && do { $have_role = 1; last;};
      }

      next unless $have_role;
    }

    # first check for client role they are top level
    if (scalar @{$script_group->{ client_roles }}) {

      # found a client role make sure we have it
      my $client_ok = 0;
      for (@{$script_group->{ client_roles }}) {
        exists $userinfo->{'client_roles'}{$_} && do {
          $client_ok = 1;
          last;
        };
      }

      next unless $client_ok;
    }

    if( !@{$script_group->{ roles }} ) {
      push @names, $script_group->{ name };
      next;
    }

    for (@{$script_group->{ roles }}) {
      exists $userinfo->{'roles'}{$_} && do {
        push @names, $script_group->{ name };
        last;
      };
    }
  }

  # sort script groups by priority
  my @sorted_names = sort { $_SCRIPT_GROUPS->{ $a }->{ pri } <=> $_SCRIPT_GROUPS->{ $b }->{ pri } } @names;

  # create custom script groups
  my @user_script_groups = ();
  my %used = ();
  for my $name (@sorted_names) {
    my %script_group = %{$_SCRIPT_GROUPS->{ $name }};

    my @sorted_paths = @{$script_group{ paths }};

    my @paths = ();
    for my $path (@sorted_paths) {
      next unless( exists $_SCRIPTS->{ $path } );
      my $script = $_SCRIPTS->{ $path };

      # no duplicate paths
      next if( exists $used{ $path } );
      $used{ $path } = $path;

      # check for client role they are top level
      if (scalar @{$script->{ client_roles }}) {

        # found a client role make sure we have it
        my $client_ok = 0;
        for (@{$script->{ client_roles }}) {
          exists $userinfo->{'client_roles'}{$_} && do {
            $client_ok = 1;
            last;
          };
        }

        next unless $client_ok;
      }

      # always add scripts with no associated roles
      if( !@{$script->{ roles }} ) {
        push @paths, $path;
        next;
      }

      # check roles
      for my $role (@{$script->{ roles }}) {
        if (exists $userinfo->{'roles'}{$role}) {
          push @paths, $path;
          last;
        }
      }
    }

    # no scripts, no script group
    next unless( @paths );

    $script_group{ paths } = \@paths;
    push @user_script_groups, \%script_group;
  }

  return \@user_script_groups;
}

sub unregister_script
{
  my ($paths) = @_;

  return unless( defined $paths );
  $paths = [ $paths ] unless( ref $paths eq 'ARRAY' );

  delete $_SCRIPTS->{ $_ } for (@{$paths});
}

sub init_scripts {
  my ($config) = @_;

  my ($file_name, $verbose, $debug, $profile, $audit) = ('',0,0,0,'');

  $debug   = 1 if exists $config->{'debug'};
  $profile = 1 if exists $config->{'profile'};
  $verbose = 1 if exists $config->{'verbose'};

  $file_name = $config->{'file_name'} if (defined $config->{'file_name'}) && $config->{'file_name'};

  print "\nstarting script write: $file_name\n" if $verbose;

  open(OUT_FILE, "> $file_name" . 't') || die "cannot open $file_name ($!)" if $file_name;

  print "  opened file...\n" if $verbose;

  # write header
  print OUT_FILE qq{#
# $file_name
#
# WWW Module/Group/Scripts init file (NOTE: auto generated)
#
# Copyright (C) 2005 Albacore Technology, LLC All Rights Reserved
#
#

use strict;

};

  # write modules first
  my $mods = HTML::Shark::D_Group::get_www_modules();

  print "  writing modules/groups...\n" if $verbose;

  print OUT_FILE q{# Modules/Groups

};

  foreach my $mod (@{$mods}) {
    my @roles;
    my @client_roles;

    my $m_roles = HTML::Shark::D_Group::get_www_module_roles(
      {'module_id' => $mod->{'module_id'}});

    my $m_client_roles = HTML::Shark::D_Group::get_www_module_client_roles(
      {'module_id' => $mod->{'module_id'}});

    push @roles, $_->{'role'} foreach (@{$m_roles});

    push @client_roles, $_->{'role'} foreach (@{$m_client_roles});

    $mod->{'pri'} ||= 99999;

    print "    $mod->{'name'}\n" if $verbose;

    print OUT_FILE qq{# ======= Module: $mod->{'name'} =======
HTML::Shark::Group::register_module
({
  'name'          => q{$mod->{'name'}},
  'title'         => q{$mod->{'title'}},
  'icon'          => q{$mod->{'icon'}},
  'menu'          => q{$mod->{'menu'}},
  'pri'           => $mod->{'pri'},
  'base'          => q{$mod->{'base'}},
  'tab'           => q{$mod->{'tab'}},
  'roles'         => [qw(@roles)],
  'client_roles'  => [qw(@client_roles)],
});
};

    # write groups
    my $groups = HTML::Shark::D_Group::get_www_groups({'module_id' =>
                                                    $mod->{'module_id'}});
    foreach my $group (@{$groups}) {
      my (@gclient_roles, @groles, @gscripts);

      my $g_roles = HTML::Shark::D_Group::get_www_group_roles(
        {'group_id' => $group->{'group_id'}});

      my $g_client_roles = HTML::Shark::D_Group::get_www_group_client_roles(
        {'group_id' => $group->{'group_id'}});

      my $g_scripts = HTML::Shark::D_Group::get_www_group_scripts(
        {'group_id' => $group->{'group_id'}});

      push @groles,          $_->{'role'} foreach (@{$g_roles});
      push @gclient_roles,   $_->{'role'} foreach (@{$g_client_roles});
      push @gscripts,        $_->{'path'} foreach (@{$g_scripts});

      $group->{'pri'} ||= 99999;

      print "      $group->{'name'}\n" if $verbose;

      print OUT_FILE qq{# +++++++ Group: $group->{'title'} +++++++
HTML::Shark::Group::register_script_group
({
  'module'        => q{$group->{'module_name'}},
  'name'          => q{$group->{'name'}},
  'title'         => q{$group->{'title'}},
  'icon'          => q{$group->{'icon'}},
  'desc'          => q{$group->{'desc'}},
  'pri'           => $group->{'pri'},
  'paths'         => [qw(@gscripts)],
  'roles'         => [qw(@groles)],
  'client_roles'  => [qw(@gclient_roles)],
});
};
    }
  }

  print "  writing scripts...\n" if $verbose;

  print OUT_FILE q{
# Scripts

HTML::Shark::Group::register_scripts
([
};

  my $scripts = HTML::Shark::D_Group::get_www_scripts();

  foreach my $script (@{$scripts}) {
    my @roles;
    my @client_roles;

    my $s_roles = HTML::Shark::D_Group::get_www_script_roles(
      {'script_id' => $script->{'script_id'}});

    my $s_client_roles = HTML::Shark::D_Group::get_www_script_client_roles(
      {'script_id' => $script->{'script_id'}});

    push @roles, $_->{'role'} foreach (@{$s_roles});

    push @client_roles, $_->{'role'} foreach (@{$s_client_roles});

    print "    $script->{'title'}\n" if $verbose;

    print OUT_FILE qq{  {
   'paths'          => [qw($script->{'path'})],
   'title'          => q{$script->{'title'}},
   'icon'           => q{$script->{'icon'}},
   'desc'           => q{$script->{'desc'}},
   'handler'        => q{$script->{'handler'}},
   'roles'          => [qw(@roles)],
   'client_roles'   => [qw(@client_roles)],
  },
};
  }

  print OUT_FILE q{]);

1;
};

  close OUT_FILE;
  rename $file_name .'t', $file_name;

  print "done\n" if $verbose;
}

1;


